home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 3: CDPD 3 / Almathera Ten on Ten - Disc 3: CDPD3.iso / fish / 001-100 / 001-025 / 024 / modula-2 / m2 / helloworld.mod < prev    next >
Text File  |  1995-03-17  |  6KB  |  227 lines
  1. (********************************************************************************
  2.  
  3. Name         : HelloWorld.MOD
  4. Version      : 1.0
  5. Purpose      : Demo For Screen And Windows From Intuition Manual
  6. Author       : ms
  7. Modified     : 1.4.86  23:48  ms
  8.  
  9. ********************************************************************************)
  10.  
  11. MODULE HelloWorld;
  12.  
  13. FROM Terminal   IMPORT WriteString, WriteLn;
  14. FROM SYSTEM     IMPORT ADDRESS, ADR, BYTE, LONG;
  15. FROM AMIGADos   IMPORT Delay;
  16. FROM AMIGABase  IMPORT ExecBase, ExecOpenLib, LibCall, Regs;
  17.  
  18. CONST CLOSEWINDOW   =   512D;
  19.       WINDOWCLOSE   =     8D;
  20.       ACTIVATE      =  4096D;
  21.       WINDOWDRAG    =     2D;
  22.       WINDOWDEPTH   =     4D;
  23.       WINDOWSIZING  =     1D;
  24.       BORDERLESS    =  2048D;
  25.       NOCAREREFRESH =131072D;
  26.       CUSTOMSCREEN  =    0FH;
  27.       WBSCREEN      =    01H; 
  28.       HIRES         =  8000H;
  29.       INTERLACE     =    04H;
  30.       RPORTOFFSET   =     25;
  31.       USERPORTOFS   =     43;
  32.  
  33. TYPE NewWindow = RECORD
  34.                    leftEdge,
  35.                    topEdge,
  36.                    width,
  37.                    height: CARDINAL;
  38.                    detailPen,
  39.                    blockPen: BYTE;
  40.                    IDCMPFlags,
  41.                    flags: LONGINT;
  42.                    firstGadget,
  43.                    checkMark: LONGINT;
  44.                    title,
  45.                    screen,
  46.                    bitMap: ADDRESS;
  47.                    minWidth,
  48.                    minHeight,
  49.                    maxWidth,
  50.                    maxHeight: CARDINAL;
  51.                    type: CARDINAL
  52.                  END;
  53.  
  54.      NewScreen = RECORD
  55.                    leftEdge,
  56.                    topEdge,
  57.                    width,
  58.                    height,
  59.                    depth: CARDINAL;
  60.                    detailPen,
  61.                    blockPen: BYTE;
  62.                    viewModes,
  63.                    type: CARDINAL;
  64.                    font,
  65.                    title,
  66.                    gadget,
  67.                    bitMap: ADDRESS
  68.                  END;
  69.  
  70.      MsgPort   = RECORD
  71.                    mpNode: ARRAY [0..13] OF BYTE;    (* TSIZE(Node) = 14  *)
  72.                    mpFlags,
  73.                    mpSigBit: BYTE;
  74.                    mpSigTask: ADDRESS;
  75.                    mpMsgList: ARRAY [0..13] OF BYTE  (* TSIZE(List) = 14 *)
  76.                  END;
  77.  
  78. (*   dummy types for window data structure *)
  79.  
  80.      Window    = ARRAY [0..63] OF CARDINAL;
  81.  
  82.      WindowPtr = POINTER TO Window;
  83.  
  84. PROCEDURE OpenLibrary(st: ARRAY OF CHAR): LONGINT;
  85. VAR r: Regs;
  86. BEGIN
  87.   r.a[1]:=ADR(st);
  88.   r.d[0]:=0D;
  89.   LibCall(ExecBase(), ExecOpenLib(), r);
  90.   RETURN r.d[0]
  91. END OpenLibrary;
  92.  
  93. VAR nw: NewWindow;
  94.     ns: NewScreen;
  95.     w: WindowPtr;
  96.     up: POINTER TO MsgPort;
  97.     s, len: LONGINT;
  98.     i, intuibase, gfxbase: LONGINT;
  99.     st, wt: ARRAY [0..31] OF CHAR;
  100.     t: ARRAY [0..99] OF CHAR;
  101.  
  102. PROCEDURE OpenWindow(VAR nw: NewWindow): WindowPtr;
  103. VAR r: Regs;
  104. BEGIN
  105.   r.a[0]:=ADR(nw);
  106.   LibCall(intuibase, -204D, r);
  107.   RETURN WindowPtr(r.d[0]);
  108. END OpenWindow;
  109.  
  110. PROCEDURE CloseWindow(w: WindowPtr);
  111. VAR r: Regs;
  112. BEGIN
  113.   r.a[0]:=LONGINT(w);
  114.   LibCall(intuibase, -72D, r);
  115. END CloseWindow;
  116.  
  117. PROCEDURE OpenScreen(VAR ns: NewScreen): LONGINT;
  118. VAR r: Regs;
  119. BEGIN
  120.   r.a[0]:=ADR(ns);
  121.   LibCall(intuibase, -198D, r);
  122.   RETURN r.d[0]
  123. END OpenScreen;  
  124.  
  125. PROCEDURE CloseScreen(s: LONGINT);
  126. VAR r: Regs;
  127. BEGIN
  128.   r.a[0]:=s;
  129.   LibCall(intuibase, -66D,r);
  130. END CloseScreen;
  131.  
  132. PROCEDURE Move(rP: ADDRESS; x, y: LONGINT);
  133. VAR r: Regs;
  134. BEGIN
  135.   r.a[1]:=rP;
  136.   r.d[0]:=x;
  137.   r.d[1]:=y;
  138.   LibCall(gfxbase, -240D, r);
  139. END Move;
  140.  
  141. PROCEDURE Wait(signalSet: LONGINT);
  142. VAR r: Regs;
  143. BEGIN
  144.   r.d[0]:=signalSet;
  145.   LibCall(ExecBase(), -318D, r);
  146. END Wait;
  147.  
  148. PROCEDURE Text(rP: ADDRESS; VAR st: ARRAY OF CHAR; len: LONGINT);
  149. VAR r: Regs;
  150. BEGIN
  151.   r.a[1]:=rP;
  152.   r.a[0]:=ADR(st);
  153.   r.d[0]:=len;
  154.   LibCall(gfxbase, -60D, r);
  155. END Text;
  156.  
  157. BEGIN
  158.   WriteString("Hello World, Screen and Window Demo from Intuition Manual"); WriteLn;
  159.   WriteString("=========================================================");
  160.   WriteLn; WriteLn;
  161.   Delay(25);
  162.   st:='intuition.library';
  163.   intuibase:=OpenLibrary(st);
  164.   st:='graphics.library';
  165.   gfxbase:=OpenLibrary(st);
  166.   IF (intuibase=0D) OR (gfxbase=0D) THEN
  167.     WriteString('Error: libraries not opened'); WriteLn
  168.   ELSE
  169.     st:='My Own Screen';
  170.     WITH ns DO
  171.       leftEdge:=0;
  172.       topEdge:=100;
  173.       width:=640;
  174.       height:=200 (* 400 *);
  175.       depth:=2;
  176.       detailPen:=BYTE(0);
  177.       blockPen:=BYTE(1);
  178.       viewModes:=HIRES (* + INTERLACE *) ;
  179.       type:=CUSTOMSCREEN;
  180.       font:=0D;
  181.       title:=ADR(st);
  182.       gadget:=0D;
  183.       bitMap:=0D
  184.     END;
  185.     s:=OpenScreen(ns);
  186.     IF s=0D THEN
  187.       WriteString('Error: screen not opend'); WriteLn;
  188.       RETURN
  189.     END;
  190.     wt:='A Simple Window';
  191.     WITH nw DO
  192.       leftEdge:=20;
  193.       topEdge:=20;
  194.       width:=600;
  195.       height:=150;
  196.       detailPen:=BYTE(0);
  197.       blockPen:=BYTE(1);
  198.       IDCMPFlags:=CLOSEWINDOW;
  199.       flags:=WINDOWCLOSE + ACTIVATE + WINDOWDRAG + WINDOWDEPTH
  200.              + WINDOWSIZING + NOCAREREFRESH;
  201.       firstGadget:=0D;
  202.       checkMark:=0D;
  203.       title:=ADR(wt);
  204.       screen:=ADDRESS(s);
  205.       bitMap:=0D;
  206.       minWidth:=130;
  207.       minHeight:=25;
  208.       maxWidth:=640;
  209.       maxHeight:=200;
  210.       type:=CUSTOMSCREEN 
  211.     END;
  212.     w:=OpenWindow(nw);
  213.     IF LONGINT(w)#0D THEN
  214.       Move(LONG(w^[RPORTOFFSET], w^[RPORTOFFSET+1]), 10D, 20D);
  215.       t:='Hello World'; len:=11D;
  216.       Text(LONG(w^[RPORTOFFSET], w^[RPORTOFFSET+1]), t, len);
  217.  
  218.       up:=ADDRESS(LONG(w^[USERPORTOFS], w^[USERPORTOFS+1]));
  219.       Wait(SHIFT(1D, CARDINAL(up^.mpSigBit)));
  220.     ELSE
  221.       WriteString('Error: OpenWindow not done '); WriteLn
  222.     END;
  223.     CloseWindow(w);
  224.     CloseScreen(s);
  225.   END;
  226. END HelloWorld.
  227.